unit unitPerfMon;

interface

uses Windows;

var
  dbUsage: Double = 0;

procedure PerfMonInit;
procedure PerfMonFree;

implementation

var
  NtQuerySystemInformation: function(infoClass: DWORD; buffer: Pointer;
    bufSize: DWORD; returnSize: PDWORD): DWORD; stdcall;

  liOldIdleTime: LARGE_INTEGER = ();
  liOldSystemTime: LARGE_INTEGER = ();
  hPerfMonThreadHandle: THandle = 0;

type
  PDWORD = ^DWORD;

  TSystem_Basic_Information = packed record
    dwUnknown1: DWORD;
    uKeMaximumIncrement: ULONG;
    uPageSize: ULONG;
    uMmNumberOfPhysicalPages: ULONG;
    uMmLowestPhysicalPage: ULONG;
    uMmHighestPhysicalPage: ULONG;
    uAllocationGranularity: ULONG;
    pLowestUserAddress: Pointer;
    pMmHighestUserAddress: Pointer;
    uKeActiveProcessors: ULONG;
    bKeNumberProcessors: byte;
    bUnknown2: byte;
    wUnknown3: word;
  end;

  TSystem_Performance_Information = packed record
    liIdleTime: LARGE_INTEGER;
    dwSpare: array [0 .. 75] of DWORD;
  end;

  TSystem_Time_Information = packed record
    liKeBootTime: LARGE_INTEGER;
    liKeSystemTime: LARGE_INTEGER;
    liExpTimeZoneBias: LARGE_INTEGER;
    uCurrentTimeZoneId: ULONG;
    dwReserved: DWORD;
  end;

procedure PerfMonThread;
var
  SysBaseInfo: TSystem_Basic_Information;
  SysPerfInfo: TSystem_Performance_Information;
  SysTimeInfo: TSystem_Time_Information;
  dbSystemTime: Double;
  dbIdleTime: Double;
const
  SystemBasicInformation = 0;
  SystemPerformanceInformation = 2;
  SystemTimeInformation = 3;

  function Li2Double(x: LARGE_INTEGER): Double;
  begin
    Result := x.HighPart * 4.294967296E9 + x.LowPart
  end;

begin
  if @NtQuerySystemInformation = nil then
    NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),
      'NtQuerySystemInformation');

  if NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo,
    SizeOf(SysBaseInfo), nil) <> 0 then
    exit;

  while true do
  begin
    if NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo,
      SizeOf(SysTimeInfo), nil) <> 0 then
      exit;

    if NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo,
      SizeOf(SysPerfInfo), nil) <> 0 then
      exit;

    if (liOldIdleTime.QuadPart <> 0) then
    begin
      dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) -
        Li2Double(liOldIdleTime);
      dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) -
        Li2Double(liOldSystemTime);
      dbIdleTime := dbIdleTime / dbSystemTime;
      dbIdleTime := 100.0 - dbIdleTime * 100.0 /
        SysBaseInfo.bKeNumberProcessors + 0.5;
      dbUsage := dbIdleTime;
    end;
    liOldIdleTime := SysPerfInfo.liIdleTime;
    liOldSystemTime := SysTimeInfo.liKeSystemTime;
    Sleep(1000);
  end;
end;

procedure PerfMonInit;
var
  A: DWORD;
begin
  hPerfMonThreadHandle := CreateThread(nil, 0, @PerfMonThread, nil, 0, A);
end;

procedure PerfMonFree;
begin
  TerminateThread(hPerfMonThreadHandle, 0);
  dbUsage := 0;
end;

end.
